home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / prot018s.zip / PROTCOMM.PAS < prev    next >
Pascal/Delphi Source File  |  1992-12-18  |  16KB  |  556 lines
  1. {                                                                         }
  2. {  Copywrite 1993 Mark Dignam - Omen Computer Services - Perth Omen BBS.  }
  3. {  This program ,including the source code MAY not be modified, changed   }
  4. {  or altered in any way without written permission of the author.        }
  5. {                                                                         }
  6. {                                                                         }
  7. { Serial Interuppt Driven Comms Driver. Required for the Protocol Engine  }
  8.  
  9. Unit ProtComm;
  10.  
  11. Interface
  12.  
  13. uses Crt,Dos;
  14.  
  15. Procedure Comm_setbaud(newrate : Longint);
  16. Function Comm_getbaud: Longint;
  17. Procedure Comm_SetDirect(Newrate : Longint);
  18. procedure Comm_setBios(newrate : longint);
  19. Function Comm_init(Baud : Longint;ThePort : Byte): Boolean;
  20. Procedure Comm_deinit;
  21. Procedure Comm_dtr_on;
  22. Procedure Comm_dtr_off;
  23. Function Comm_Tx_ready : boolean;
  24. Function Comm_Carrier : boolean;
  25. Function Comm_Rx_ready : boolean;
  26. Function Comm_Rx : byte;
  27. Procedure Comm_Tx(ch : byte);
  28. Procedure Comm_FlushOut;
  29. Procedure Comm_ClearOut;
  30. Procedure Comm_ClearIn;
  31. Procedure Comm_SendBreak;
  32. Procedure Comm_Cts_Rts(OnOff : Boolean);
  33.  
  34. Var
  35.    CanUseFossil : Boolean;
  36.    UsedPort     : Byte;
  37.  
  38. IMPLEMENTATION
  39.  
  40. CONST
  41.   MaxPhysPort    = 7 ;
  42.   BufferSize     = 8196;
  43.   BufferMax      = 8195;
  44.  
  45.   CommInterrupt  = $14 ;
  46.   I8088_IMR      = $21 ; { port address of the Interrupt Mask Register }
  47.  
  48.   { register offsets from base of IBM 8250 UART }
  49.   IBM_UART_THR         = $00 ;
  50.   IBM_UART_RBR         = $00 ;
  51.   IBM_UART_IER         = $01 ;
  52.   IBM_UART_IIR         = $02 ;
  53.   IBM_UART_LCR         = $03 ;
  54.   IBM_UART_MCR         = $04 ;
  55.   IBM_UART_LSR         = $05 ;
  56.   IBM_UART_MSR         = $06 ;
  57.  
  58.   PortTable      : ARRAY [0..MaxPhysPort] OF RECORD
  59.     Base : word ;
  60.     IRQ  : byte
  61.     END  { PortTable record } = ( (Base : $3f8 ;  IRQ : 4),
  62.                                   (Base : $2f8 ;  IRQ : 3),
  63.                                   (Base : $3e8 ;  IRQ : 4),
  64.                                   (Base : $2e8 ;  IRQ : 3),
  65.                                   (Base : 0 ;  IRQ : 0),
  66.                                   (Base : 0 ;  IRQ : 0),
  67.                                   (Base : 0 ;  IRQ : 0),
  68.                                   (Base : 0 ;  IRQ : 0) ) ;
  69.  
  70. Var
  71.   BIOS_Ports              : byte ;
  72.   ExitSave                : pointer ;
  73.   OriginalVector          : pointer ;
  74.   IsOpen,OverFlow         : BOOLEAN ;
  75.   Base                    : word ;       { base for open port }
  76.   IRQ                     : byte ;       { irq  for open port }
  77.   Buffer                  : ARRAY [0..BufferMax] OF byte ;
  78.   BufferHead              : word ;       { Location in Buffer to put next char }
  79.   BufferTail              : word ;       { Location in Buffer to get next char }
  80.   BufferNewTail           : word ;
  81.   Regs                    : registers;
  82.   Status,RxWord                  : word;
  83.   UseFossil                      : Boolean;
  84.   Old_IER,Old_IIR,Old_LCR,
  85.   Old_MCR,Old_IMR                :byte;
  86.   Cts_Rts_on                     : Boolean;
  87.   CtsTimer                       : Word;
  88.  
  89. procedure Comm_setBios(newrate : longint);
  90. var
  91.   BaudRate    : Byte;
  92.   Temp0       : Integer;
  93.  
  94.   begin
  95.    Temp0 := NewRate Div 10;
  96.    case Temp0 of
  97.        30         : baudrate := $43;
  98.        60         : baudrate := $63;
  99.        120        : baudrate := $83;
  100.        240        : baudrate := $a3;
  101.        480        : baudrate := $c3;
  102.        960        : baudrate := $e3;
  103.        1920       : baudrate := $03;
  104.        3840       : baudrate := $23;
  105.    end;
  106.      regs.ah := 0;
  107.      regs.al := baudrate;
  108.      regs.dx := usedport;
  109.      Intr($14,regs);
  110. end;
  111.  
  112.  
  113. Procedure Comm_SetDirect(Newrate : Longint);
  114. Var
  115.    i,j,k        : word;
  116.    temp       : longint;
  117.  
  118.   begin
  119.      temp := 115200;
  120.      Temp := temp div Newrate;
  121.      Move(Temp,j,2);
  122.      k := port[ibm_Uart_Lcr + base];
  123.      port[ibm_Uart_Lcr + base] := $80;
  124.      Port[Ibm_uart_thr + base] := lo(j);
  125.      Port[Ibm_uart_ier + base]:= hi(j);
  126.      Port[Ibm_Uart_Lcr + base] := $3;
  127.   end;
  128.  
  129. procedure Comm_setbaud(newrate : longint);
  130.  
  131.   begin
  132.    If UseFossil then Comm_SetBios(NewRate) else
  133.       Comm_SetDirect(newrate);
  134.   end;
  135.  
  136. Function Comm_getbaud: Longint;
  137. Var
  138.    i,j,k      : word;
  139.    temp       : longint;
  140.  
  141.   begin
  142.     k := port[ibm_Uart_Lcr + base];
  143.     port[ibm_Uart_Lcr + base] := k or $80;
  144.      i := Port[Ibm_uart_thr + base];
  145.      j := Port[Ibm_uart_ier + base];
  146.      j := j * $100;
  147.      j := j + i;
  148.     Port [Ibm_Uart_Lcr + base] := k;
  149.        temp := 115200;
  150.        temp := temp div j;
  151.      Comm_GetBaud := temp;
  152.   end;
  153.  
  154. function Comm_Carrier : boolean;
  155. begin
  156.  
  157. Inline
  158.     ($B4/$03/            { Mov ah,3       }
  159.      $8b/$16/UsedPort/   { Mov Dx,Usedport}
  160.      $cd/$14/            { Int 14         }
  161.      $a3/Status);        { Mov Status,Ax  }
  162.      Comm_carrier := ((Status and 128) <> 0);
  163. end;
  164.  
  165.  
  166. PROCEDURE DisableInterrupts ;   inline( $FA {cli} ) ;
  167. PROCEDURE EnableInterrupts ;    inline( $FB {sti} ) ;
  168.  
  169. {---------------------------------------------------------------------------}
  170. {                      ISR - Interrupt Service Routine                      }
  171. {---------------------------------------------------------------------------}
  172.  
  173. PROCEDURE ISR ; INTERRUPT ;
  174. { Interrupt Service Routine }
  175. { Invoked when the USART has received a byte of data from the comm line }
  176. { More mods by MFD 10th May 1992 for 16550's FIFO's                     }
  177. BEGIN { ISR }
  178.   inline(
  179.     $FB/                                { sti                           }
  180.     {Start:                                                             }
  181.     { get the incoming character                                        }
  182.     { Buffer[BufferHead] := chr(port[base + ibm_uart_rbr]);             }
  183.     $8B/$16/Base/                       { mov dx,Base                   }
  184.     $EC/                                { in al,dx                      }
  185.     $8B/$1E/BufferHead/                 { mov bx,BufferHead             }
  186.     $88/$87/Buffer/                     { mov Buffer[bx],al             }
  187.     { BufferNewHead := succ(BufferHead);                                }
  188.     $43/                                { inc bx                        }
  189.     { if BufferNewHead > BufferMax then BufferNewHead := 0 ;            }
  190.     $81/$FB/BufferMax/                  { cmp bx,BufferMax              }
  191.     $7E/$02/                            { jle l001                      }
  192.     $33/$DB/                            { xor bx,bx                     }
  193.     { if BufferNewHead = BufferTail then Overflow := true               }
  194.     {L001:                                                              }
  195.     $3B/$1E/BufferTail/                 { cmp bx,BufferTail             }
  196.     $75/$07/                            { jne L002                      }
  197.     $C6/$06/Overflow/$01/               { mov overflow,1                }
  198.     $EB/$0E/                            { jmp short L003                }
  199.     { ELSE BEGIN                                                        }
  200.     {   BufferHead := BufferNewHead;                                    }
  201.     {   Async_BufferUsed := succ(Async_BufferUsed);                     }
  202.     {   IF Async_BufferUsed > Async_MaxBufferUsed then                  }
  203.     {     Async_MaxBufferUsed := Async_BufferUsed                       }
  204.     {   END ;                                                           }
  205.     {L002:                                                              }
  206.     $89/$1E/BufferHead/                 { mov BufferHead,bx             }
  207.     $83/$C2/$05/                        { Add dx,5                      }
  208.     { Check FIFO - And process if more bytes.                           }
  209.     $EC/                                { In al,dx                      }
  210.     $24/$01/                            { And al,$01                    }
  211.     $3C/$01/                            { cmp al,$01                    }
  212.     $74/$CF/                            { je start:                     }
  213.     {L003:                                                              }
  214.     $FA/                                { cli                           }
  215.     { issue non-specific EOI                                            }
  216.     { port[$20] := $20 ;                                                }
  217.     $B0/$20/                            { mov al,20h                    }
  218.     $E6/$20                             { out 20h,al                    }
  219.     )
  220.   END { ISR } ;
  221.  
  222. PROCEDURE Async_Close ;
  223.  
  224. { reset the interrupt system when USART interrupts no longer needed }
  225.  
  226.  
  227. BEGIN { Async_Close }
  228.  
  229. if IsOpen then
  230.   begin
  231.     DisableInterrupts;
  232.     port[I8088_IMR] := (port[I8088_IMR] or (1 shl IRQ));
  233.     port[Base + IBM_UART_IER] := old_IER;
  234.     EnableInterrupts ;
  235.     port[Base + IBM_UART_MCR] := Old_Mcr;
  236.     port[Base + IBM_UART_LCR] := Old_lcr;
  237.     SetIntVec( IRQ + 8, OriginalVector ) ;
  238.     IsOpen := False;
  239.     End;
  240. End;
  241.  
  242. Function init_fossil(Baud : longint;ThePort : Byte): Boolean;
  243.  
  244. begin
  245.      usedPort := ThePort - 1;
  246.      regs.ah := $4;
  247.      regs.dx := usedport;
  248.      intr($14,regs);
  249.      if regs.ax <> $1954 then Init_fossil := False
  250.         Else
  251.           begin
  252.             Init_Fossil := true;
  253.             UseFossil := True;
  254.             Comm_SetBaud(Baud);
  255.           end;
  256. end;
  257.  
  258. Function Async_Open(Baud : Longint; LogicalPortNum: byte): boolean;
  259.  
  260. VAR
  261.     i,oldIIR : byte ;
  262.     Fifos,Portthere  : Boolean;
  263.  
  264. BEGIN { Async_Open }
  265.   IF NOT IsOpen THEN
  266.     BEGIN
  267.       BufferHead       := 0 ;
  268.       BufferTail       := 0 ;
  269.       Overflow         := FALSE;
  270.       UsedPort   := PRED(LogicalPortNum);
  271.       fifos := false;
  272.       IsOpen := false;
  273.      If PortTable[UsedPort].Base <> 0 then
  274.        BEGIN
  275.           Base := PortTable[usedPort].Base ;
  276.           IRQ  := PortTable[usedPort].IRQ ;
  277.           Old_ier := port[Base + IBM_UART_IER];
  278.           Old_Mcr := port[Base + IBM_UART_MCR];
  279.           Old_Lcr := port[Base + IBM_UART_LCR];
  280.           Port[Base + Ibm_Uart_Lcr] := $75;
  281.           PortThere := (Port[Base + Ibm_Uart_Lcr] = $75);
  282.           Port[Base + Ibm_Uart_Lcr] := $3;
  283.           If PortThere Then
  284.              begin
  285.                 Comm_SetDirect(Baud);
  286.                 port[IBM_UART_MCR + Base] := $0b; { Turn on RTS/DTR     }
  287.                 OldIIR := Port[base+Ibm_Uart_IIR];
  288.                 Port[base + Ibm_Uart_IIR] := 1;            {check for Fifos!}
  289.                 Fifos := (port[base + Ibm_uart_IIR] And $c0 = $c0);
  290.                 If Not Fifos then Port[base + Ibm_Uart_IIR] := OldIIR;
  291.                 GetIntVec(IRQ + 8,OriginalVector);
  292.                 SetIntVec(IRQ + 8,@ISR);
  293.                 DisableInterrupts ; { --- ENTER CRITICAL REGION -------------------- }
  294.                 port[I8088_IMR] := (port[I8088_IMR] and ((1 shl IRQ) xor $FF)) ;
  295.                 port[IBM_UART_IER + Base] := $01; { enable data ready interrupt }
  296.                 EnableInterrupts ;  { --- EXIT CRITICAL REGION --------------------- }
  297.                 IsOpen := TRUE
  298.              end;
  299.        END;
  300.     END;
  301.    Async_Open := IsOpen
  302.   END { Async_Open } ;
  303.  
  304.  
  305. {$F+}
  306. PROCEDURE TerminateUnit ; {$F-}
  307.  
  308. BEGIN { TerminateUnit }
  309.   Async_Close ;
  310.   ExitProc := ExitSave
  311.   END { TerminateUnit } ;
  312.  
  313. Function Comm_init(Baud : Longint;ThePort : Byte): Boolean;
  314.  
  315.  begin
  316.   UseFossil := False;
  317.   If not IsOpen then
  318.    begin
  319.      if (canusefossil) and (Init_Fossil(baud,ThePort)) then
  320.       begin
  321.        Comm_Init := True;
  322.        IsOpen := True;
  323.        Base := PortTable[usedPort].Base ;
  324.        end
  325.     else
  326.       Begin
  327.         If Async_Open(Baud,ThePort) then
  328.           Begin
  329.             Comm_Init := true;
  330.             IsOpen := True;
  331.           End
  332.         else
  333.          Comm_Init := False;
  334.       End;
  335.    End;
  336.  End;
  337.  
  338. Function Comm_Rx_ready : boolean;
  339. Var
  340.   AHigh : Byte;
  341.  
  342.  Begin
  343.      if UseFossil Then
  344.        Begin
  345.         Inline
  346.         ($B4/$03/            { Mov ah,3 }
  347.          $8b/$16/UsedPort/   { Mov Dx,[Usedport]}
  348.          $cd/$14/            { Int 14}
  349.          $a3/Status);        { Mov [Status],Al   }
  350.          Comm_Rx_ready := ((Status and $100) <> 0);
  351.        end
  352.      Else
  353.          Comm_Rx_ready := (Bufferhead <> BufferTail);
  354.  End;
  355.  
  356. Procedure Comm_deinit;
  357.    begin
  358.      If IsOpen then
  359.         Begin
  360.            If UseFossil then
  361.            Begin
  362.              regs.ah := $5;
  363.              regs.dx := usedport;
  364.              intr($14,regs);
  365.            end
  366.            else Async_Close;
  367.            IsOpen := False;
  368.         end;
  369.    End;
  370.  
  371. Function Comm_Rx: byte;
  372.  Begin
  373.        If UseFossil then
  374.         Begin
  375.              Inline
  376.              ($B4/$02/            { Mov ah,3 }
  377.               $8b/$16/UsedPort/   { Mov Dx,[Usedport]}
  378.               $cd/$14/            { Int 14}
  379.               $a3/RXWord);        { Mov [Status],Al   }
  380.               Comm_Rx := lo(RXWord);
  381.          end
  382.           else
  383.          Begin
  384.                Comm_Rx         := Buffer[BufferTail] ;
  385.                BufferTail := (SUCC( BufferTail ) MOD BufferSize) ;
  386.          end;
  387.  end;
  388.  
  389. Function Comm_Tx_ready : boolean;
  390.  
  391. Var Ahigh  : Byte;
  392.     carr, Cts,Thr   : boolean;
  393. begin
  394.  
  395.  If useFossil then
  396.    begin
  397.    Inline
  398.     ($B4/$03/            { Mov ah,3       }
  399.      $8b/$16/UsedPort/   { Mov Dx,Usedport}
  400.      $cd/$14/            { Int 14         }
  401.      $a3/Status);        { Mov Status,Ax  }
  402.      Thr := (Status and $2000) <> 0;
  403.      Carr := (Status and $0080) <> 0;
  404.      Comm_Tx_Ready := Thr or (not Carr);
  405.    End
  406.  Else
  407.    Begin
  408.        Thr := ((port [IBM_UART_LSR + Base] and $20) <> 0);
  409.        Cts := (port[ibm_uart_msr +base] and $10 = $10);
  410.        If Cts_Rts_On and Comm_Carrier then
  411.          Comm_Tx_Ready := THR and Cts
  412.        else
  413.          Comm_Tx_ready := Thr;
  414.    end;
  415.  end;
  416.  
  417. Procedure Comm_Tx(ch : byte);
  418.   Begin
  419.  
  420.     Repeat
  421.     until Comm_Tx_Ready;
  422.  
  423.     If UseFossil then
  424.        Begin
  425.            regs.ah := $01;
  426.            regs.al := ch;
  427.            regs.dx := usedport;
  428.            intr($14,regs);
  429.        End
  430.     else
  431.      port[IBM_uart_thr + base] := ch;
  432.   end;
  433.  
  434. Procedure Comm_FlushOut;
  435.  Begin
  436.    If Usefossil then
  437.     begin
  438.         regs.Ah := $8;
  439.         Regs.dx := usedport;
  440.         Intr($14,regs);
  441.     end;
  442.  end;
  443.  
  444.  
  445. Procedure Comm_ClearOut;
  446.   Begin
  447.    If UseFossil Then
  448.       Begin
  449.          Regs.Ah := $9;
  450.          Regs.Dx := usedport;
  451.          Intr($14,regs);
  452.       End;
  453.   end;
  454.  
  455. Procedure Comm_ClearIn;
  456.   Begin
  457.    If UseFossil then
  458.     Begin
  459.       Regs.Ah := $0a;
  460.       Regs.Dx := usedport;
  461.       Intr($14,Regs);
  462.     end
  463.    else
  464.     Begin
  465.       BufferHead := 0;
  466.       BufferTail := 0;
  467.       OverFlow   := False;
  468.     End;
  469.   End;
  470.  
  471. Procedure Comm_SendBreak;
  472.  
  473. Var
  474.    I,j : Byte;
  475.  Begin
  476.    If UseFossil then
  477.      Begin
  478.       Regs.AX := $1a01;
  479.       Regs.Dx := UsedPort;
  480.       Intr($14,regs);
  481.       Delay(100);
  482.       Regs.Ax := $1a00;
  483.       Regs.Dx := UsedPort;
  484.       Intr($14,regs);
  485.      end
  486.    else
  487.      Begin
  488.       I := port[IBM_UART_LCR + Base];
  489.       J := i;
  490.       I := I And $7f;
  491.       I := I or $40;
  492.       Port[IBM_UART_LCR + Base] := I;
  493.       delay(100);
  494.       port[IBM_UART_LCR + Base] := j;
  495.      End;
  496.   End;
  497.  
  498. Procedure Comm_dtr_on;
  499.  
  500. Var    i      : Byte;
  501.  
  502. begin
  503.      If UseFossil then
  504.       Begin
  505.         regs.ah := $06;
  506.         regs.al := $01;
  507.         regs.dx := usedport;
  508.         intr($14,regs);
  509.       end
  510.      else
  511.       Port [IBM_UART_MCR + Base] := $0b;
  512. End;
  513.  
  514. Procedure Comm_dtr_off;
  515. Var
  516.    I     : Byte;
  517.  
  518. begin
  519.    if UseFossil then
  520.      begin
  521.         regs.ah := $06;
  522.         regs.al := $00;
  523.         regs.dx := Usedport;
  524.         intr($14,regs);
  525.      end
  526.     else
  527.      Port[IBM_Uart_MCR + Base] := $0a;
  528. end;
  529.  
  530. Procedure Comm_Cts_Rts(OnOff : Boolean);
  531.  
  532. begin
  533.   if UseFossil then
  534.     begin
  535.      Regs.dx := USedPort;
  536.      If OnOff then regs.al := 2 else Regs.al := 0;
  537.      Regs.ah := $0f;
  538.      Intr($14,regs);
  539.     end
  540.   else
  541.     Cts_Rts_On := OnOff;
  542. end;
  543.  
  544.  
  545. BEGIN { InitializeUnit }
  546.   ExitSave := ExitProc ;
  547.   ExitProc := @TerminateUnit ;
  548.   IsOpen   := FALSE ;
  549.   Overflow := FALSE ;
  550.   CanUseFossil := True;
  551.   Cts_rts_on := True;
  552.   Bios_Ports := 4;
  553. end.
  554.  
  555.  
  556.